#!/usr/bin/perl -w
# rblsrv.pl - RBL(DNSBL) Server
#author desenix@gmail.com
# Version 0.3 beta
# Add Answer Text Records.
use IO::Socket;
use POSIX;

# CONFIG =====================
$logfile="/server/scr/rblsrv/log/rblsrv.log";
$errfile="/server/scr/rblsrv/log/rblsrv.err";
$PORTNO = 153;
# The forbidden words list, for a reverse zone
@BADREV = ("broadband", "localhost","^.[a-fA-F0-9]{14,}");
# Cache Size
$CSz=1024;
#=============================

$RPOS=0;
$TPOS=0;

$RSTR="";
@RARR=();
@TARR=();

$REQ_NAME="";
$REQ_POSN=12;
$REQ_TYPE=0;
$REQ_CLASS=0;

$DNS_ID  = 0;
$DNS_FLG = 0;
$CNT_REQ = 0;
$CNT_RES = 0;
$CNT_ATH = 0;
$DNS_REC = 0;

#============================================
# Passage in a demon mode, only for *nix systems
# author http://www.inattack.ru/article/616.html
sub Daemonize
{
print "Daemonize RBL\n";
return if ($^O eq 'MSWin32'); # если Windows то выйдем.
# chdir '/' or die "Can't chdir to /: $!"; # не мешаем unmount
umask 0; # устанавливаем разрешения открываемых файлов по умолчанию
open STDIN, '/dev/null'   or die "Can't read /dev/null: $!"; # перенаправим ввод в нуль
open STDOUT, ">$logfile" or die "Can't write to /dev/null: $!"; # перенаправим вывод
open STDERR, ">$errfile" or die "Can't write to /dev/null: $!"; # перенаправим вывод
defined(my $pid = fork)   or die "Can't fork: $!"; # пытаемся выполнить fork
exit if $pid; # я родитель, если получен id дочернего процесса
setsid or die "Can't start a new session: $!"; # обосабливаемся
}

#============================================
#Glob Var Cache
$CIDX=0;
@CIP=();
@CREV=();
@CFWD=();
#============================================
sub GetRevZone
{
my @prm = @_;
my $idx=0;
my $res="";
my $fnd=0;
my $ip = $prm[0];
#search in cache
while($idx<$CSz)
	{
	if(defined($CIP[$idx])){ if($CIP[$idx] eq $ip){ $res=$CREV[$idx]; $fnd=1; } }
	$idx=$idx+1;
	}
if($fnd==0)
	{
	$res=gethostbyaddr($ip, AF_INET);
	$CIP[$CIDX]=$ip;
	if(!defined($res)){ $res=""; }
	$CREV[$CIDX]=$res;
	$CFWD[$CIDX]=-1;
	print"Add To Cache $CIDX $res\n";
	$CIDX=$CIDX+1; if($CIDX>=$CSz){ $CIDX=0; }
	}else{ print"Find To Cache $res\n";  }
return($res);
}
#============================================
sub TstFwdZone
{
my @prm = @_;
my ($name, $aliases, $addrtype, $length);
my @fwd=();
my $fnd=0;
my $ich=-1;
my $i;
my $fsz=0;
my $rev = $prm[0];
if(!defined($rev)){ print"Fwd error rev\n"; $fnd=1; return($fnd); }
if(length($rev)==0){ print"Fwd error rev\n"; $fnd=1; return($fnd); }
#search in cache
$i=0;
while($i < $CSz)
	{
	if(defined($CREV[$i])){ if($CREV[$i] eq $rev){ $fnd=$CFWD[$i]; $ich=$i; } }
	$i=$i+1;
	}
#if($fnd==0){ print"Rev No Cache\n"; $fnd=1; return($fnd); }
if($fnd == -1)
	{
	($name, $aliases, $addrtype, $length, @fwd) = gethostbyname("$rev");
	#print("Len=$#fwd @fwd\n");
	if($#fwd>=0)
		{#Add To Cahe
		$fnd=1; $i=0; $fsz=$#fwd+1;
		while($i<$fsz)
			{
			if($CIP[$ich] eq $fwd[$i]) { $fnd=0; }
			$i=$i+1;
			}
		$CFWD[$ich] = $fnd;
		print"Fwd Set $fnd To Cache $ich\n";
		}else{
		$CFWD[$ich] = 1;
		print"Fwd Set To Cache $ich\n";
		return($CFWD[$ich]);
		}
	}
print"Fwd Test $fnd\n";
return($fnd);
}
#============================================
#Add header
sub GenRespAddHeader
{
#Add pointer name req
$TARR[$TPOS] = 192 + int($REQ_POSN / 256); $TPOS=$TPOS+1;
$TARR[$TPOS] = $REQ_POSN % 256; $TPOS=$TPOS+1;
#Add TYPE
$TARR[$TPOS] = int($REQ_TYPE / 256); $TPOS=$TPOS+1;
$TARR[$TPOS] = $REQ_TYPE % 256; $TPOS=$TPOS+1;
#Add CLASS
$TARR[$TPOS] = int($REQ_CLASS / 256); $TPOS=$TPOS+1;
$TARR[$TPOS] = $REQ_CLASS % 256; $TPOS=$TPOS+1;
#Add TTL 3600
$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
$TARR[$TPOS] = 14; $TPOS=$TPOS+1;
$TARR[$TPOS] = 16; $TPOS=$TPOS+1;

#ADD 1 counter resp.
$CNT_RES=$CNT_RES+1;

#set Flags
$DNS_FLG = 34176; # RES
}

#============================================
# create the answer
sub GenResp
{
my ($gen, @ip);
my @prm = @_;
$gen = $prm[0];
@ip  = ($prm[1],$prm[2],$prm[3],$prm[4]);
print "GEN=@prm\n";

GenRespAddHeader();

if($REQ_TYPE==1){
	if($gen==1){
		#Add LEN IP
		$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
		$TARR[$TPOS] = 4; $TPOS=$TPOS+1;
		#Add IP
		$TARR[$TPOS] = 127; $TPOS=$TPOS+1;
		$TARR[$TPOS] = 0;   $TPOS=$TPOS+1;
		$TARR[$TPOS] = 0;   $TPOS=$TPOS+1;
		$TARR[$TPOS] = 2;   $TPOS=$TPOS+1;
		print("Add IP adr\n");
		}else{
		#Add LEN IP
		$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
		$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
		$CNT_RES = 0; $gen=0;
		$DNS_FLG = $DNS_FLG | 3;
		print("Name Not Found\n");
		}#if gen
	}# if Type==1
	elsif($REQ_TYPE==16){ # TXT
	#Add Text BlackList
	#Len
	$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
	$TARR[$TPOS] = 17; $TPOS=$TPOS+1;
	#len
	$TARR[$TPOS] = 16; $TPOS=$TPOS+1;
	#String
	$TARR[$TPOS] = ord('A'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('u'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('t'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('o'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('G'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('e'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('n'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('B'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('l'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('a'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('c'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('k'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('L'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('i'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('s'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('t'); $TPOS=$TPOS+1;
	print("Add TEXT\n");
	}# if Type==16
	elsif($REQ_TYPE==12){
	#Add name localhost
	$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
	$TARR[$TPOS] = 11; $TPOS=$TPOS+1;
	$TARR[$TPOS] = 9; $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('l'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('o'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('c'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('a'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('l'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('h'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('o'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('s'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = ord('t'); $TPOS=$TPOS+1;
	$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
	print("Add localhost name\n");
	}
	else{
	#Add LEN section
	$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
	$TARR[$TPOS] = 0; $TPOS=$TPOS+1;
	$CNT_RES = 0; $gen=0;
	$DNS_FLG = $DNS_FLG | 4;
	print("Unknow Type Req $REQ_TYPE\n");
	}
#Change Header
#$CNT_ATH = $CNT_RES; $CNT_RES = 0;
#Flags
$RARR[2] = int($DNS_FLG / 256);
$RARR[3] = $DNS_FLG % 256;
#Counter Resp
$RARR[6] = int($CNT_RES / 256);
$RARR[7] = $CNT_RES % 256;
# Count Auth
$RARR[8] = int($CNT_ATH / 256);
$RARR[9] = $CNT_ATH % 256;
# Add rec
$DNS_REC=0;
$RARR[10] = int($DNS_REC / 256);
$RARR[11] = $DNS_REC % 256;
}

#============================================
# check up a reverse zone
sub TestRev
{
my @prm = @_;
my ($rev, @ip, $ipaddr, @iph, $fhex, $fip);
my ($name, $aliases, $addrtype, $length, @addrs);
my $res=0;
$fhex = 0;
$fip = 0;
$rev = $prm[0];
@ip  = ($prm[1],$prm[2],$prm[3],$prm[4]);
$ip[0]=~s/\s//g;
$ip[1]=~s/\s//g;
$ip[2]=~s/\s//g;
$ip[3]=~s/\s//g;
if($ip[0]==127 && $ip[1]==0 && $ip[2]==0 && $ip[3]==1) { return($res,@ip); }
if(length($rev)==0) { $res=1; return($res,@ip); }
$ipaddr = $prm[5];
$ipaddr =~ s/(.)/sprintf("%02x.",ord($1))/eg;
@iph = split(/\./, $ipaddr, 5);
$iph[0]=~s/\s//g;
$iph[1]=~s/\s//g;
$iph[2]=~s/\s//g;
$iph[3]=~s/\s//g;
##print "TestRev $rev IP=@ip @iph \n";
if($rev=~m/$ip[0]/i) { $fip=$fip+1; }else{ print "$ip[0] "; }
if($rev=~m/$ip[1]/i) { $fip=$fip+1; }else{ print "$ip[1] "; }
if($rev=~m/$ip[2]/i) { $fip=$fip+1; }else{ print "$ip[2] "; }
if($rev=~m/$ip[3]/i) { $fip=$fip+1; }else{ print "$ip[3] "; }
if($rev=~m/$iph[0]/i) { $fhex=$fhex+1; }else{ print "$iph[0] "; }
if($rev=~m/$iph[1]/i) { $fhex=$fhex+1; }else{ print "$iph[1] "; }
if($rev=~m/$iph[2]/i) { $fhex=$fhex+1; }else{ print "$iph[2] "; }
if($rev=~m/$iph[3]/i) { $fhex=$fhex+1; }else{ print "$iph[3] "; }
print " not found\n";
if($fip>=2 || $fhex>=2) { $res=1; }
print "Find dec=$fip hex=$fhex\n";
$revmask=join('|',@BADREV);
##print"MASKREV $revmask\n";
if($rev=~m/$revmask/i) { $res=1; print"BADREV \n"; }
if(($res==0)&&(length($rev)>0)) { $res=TstFwdZone($rev); }
return($res,@ip);
}

#============================================
# request a reverse zone
sub GetRev
{
my $err=0;
my @prm = @_;
my $req=$prm[0];
my @arr=();
my ($ipaddr, $rev, $fwd, $slen, @ip);
#print("Req=$req \n");
@arr = split(/\./, $req, 5);

if(!defined($arr[0])) { $arr[0]=0; }
if(!defined($arr[1])) { $arr[1]=0; }
if(!defined($arr[2])) { $arr[2]=0; }
if(!defined($arr[3])) { $arr[3]=0; }

if (($arr[0] =~ /\D+/) || ($arr[0] eq "")) { $arr[0]=0; $err=1; }
if (($arr[1] =~ /\D+/) || ($arr[1] eq "")) { $arr[1]=0; $err=1; }
if (($arr[2] =~ /\D+/) || ($arr[2] eq "")) { $arr[2]=0; $err=1; }
if (($arr[3] =~ /\D+/) || ($arr[3] eq "")) { $arr[3]=0; $err=1; }

$ip[0]=int($arr[3]); $ip[1]=int($arr[2]); $ip[2]=int($arr[1]); $ip[3]=int($arr[0]);

if( $ip[0] >= 0 && $ip[0] < 256 && $ip[1] >= 0 && $ip[1] < 256 && $ip[2] >= 0 && $ip[2] < 256 && $ip[3] >= 0 && $ip[3] < 256 && $err==0 ) {
	$ipaddr = chr($ip[0]).chr($ip[1]).chr($ip[2]).chr($ip[3]);
	if($REQ_TYPE == 1){$rev=GetRevZone($ipaddr);}else{$slen=0; $rev="";}
#	if($REQ_TYPE == 1){$rev=gethostbyaddr($ipaddr, AF_INET);}else{$slen=0; $rev="";}
	if(defined($rev)) {$slen=length($rev);}else{$slen=0; $rev="";}
	}else{ $slen=0; $rev=""; }
print("Rev[$slen]=$rev ip=@ip\n");
return($rev,@ip,$ipaddr);
}

#============================================
# Request analysis
sub ParseReq
{
my @prm = @_;
my $str="";
my $LEN=0;
$REQ_TYPE=0;
$REQ_CLASS=0;
$REQ_POSN = $RPOS;
while($RARR[$RPOS]>0){ $LEN = $RARR[$RPOS]; $RPOS=$RPOS+1;
	$str=$str.substr($RSTR, $RPOS, $LEN).".";
	$RPOS = $RPOS + $LEN;
	}#while
	$RPOS = $RPOS + 1;
	$REQ_NAME = $str;
	$REQ_TYPE  = $RARR[$RPOS+0] * 256 + $RARR[$RPOS+1];
	$REQ_CLASS = $RARR[$RPOS+2] * 256 + $RARR[$RPOS+3];
	$RPOS = $RPOS + 4;
print "TYPE=$REQ_TYPE CLASS=$REQ_CLASS STRREQ=$REQ_NAME\n";
}

#============================================
my($sock, $oldmsg, $hisaddr, $hishost, $MAXLEN);
$MAXLEN = 2048;
$sock = IO::Socket::INET->new(LocalPort => $PORTNO, Proto => 'udp') or die "socket: $@";
print "Listen UDP port $PORTNO\n";

Daemonize(); # демонизируемся

$tm = localtime();
print("Start Server $tm\n");

while ($sock->recv($RSTR, $MAXLEN)) {
	my($port, $ipaddr) = sockaddr_in($sock->peername);
	$hishost = gethostbyaddr($ipaddr, AF_INET);
	#print "Client $hishost said $newmsg \n";

	print "\n";
	$tm = localtime();
	print "$tm\n";

	# Get BIN data
	@RARR = ();
	@RARR = unpack("U*", $RSTR);
	# $TPOS = $#RARR;
        $TPOS = 0;
	@TARR = ();
##	print "R=@RARR \n";

	# Parse Header
	$DNS_ID  = $RARR[0]  * 256 + $RARR[1];
	$DNS_FLG = $RARR[2]  * 256 + $RARR[3];
	$CNT_REQ = $RARR[4]  * 256 + $RARR[5];
	$CNT_RES = $RARR[6]  * 256 + $RARR[7];
	$CNT_ATH = $RARR[8]  * 256 + $RARR[9];
	$DNS_REC = $RARR[10] * 256 + $RARR[11];
	print "HEADER: ID=$DNS_ID FLG=$DNS_FLG Req=$CNT_REQ Res=$CNT_RES AUTH=$CNT_ATH REC=$DNS_REC\n";

	#Parse REQ
	$CR=0; $RPOS=12;
	while($CR < $CNT_REQ){ $CR=$CR+1; 
		ParseReq();
		@ares = GetRev($REQ_NAME);
		@ares = TestRev(@ares);
		GenResp(@ares);
	}#while PASE REQ

	#Copy Data
	@TRAN = ();
	$i=0;
	while($i<$RPOS) { $TRAN[$i]=$RARR[$i]; $i=$i+1; }
	$i=0;
	while($i<$TPOS) { $TRAN[$RPOS+$i]=$TARR[$i]; $i=$i+1; }

	#TRANSMIT
##        print "T=@TRAN \n";
        $RSTR = pack ("U*", @TRAN);
	$sock->send($RSTR);

$RSTR="";
} die "recv: $!";
